home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / dev / e / mycalc.lha / MyCalc / MyCalc.e < prev    next >
Encoding:
Text File  |  1993-09-29  |  6.6 KB  |  184 lines
  1. /*   
  2.    This is the source for a little calculator. The provided calculator
  3.    coming with Amiga_E as example was to unflexible for me, so I
  4.    wrote my own one. If you want to use parts of the source in your
  5.    own projects you can do that. Expanding the functionality shouldn't
  6.    be so hard. for that have a look for the
  7.    op()      - checks for infix operators,
  8.    exp()     - calculates the results for all infix, prefix and postfix
  9.                operators
  10.    postfix() - checks for postfix operators
  11.    prefix()  - checks for prefix operators
  12.    func()    - checks for functions and calculates 'em
  13.    procedures.
  14.  
  15.    Backus Nauer form of how a term looks like:
  16.      term    = "(" term ")" | term op term | num | func
  17.      func    = Abs()
  18.      num     = [prefix] E-numeric [postfix]
  19.      prefix  = "~"
  20.      postfix = "!"
  21.      op      = "*" | "/" | "+" | "-" | "^" | "mod" | "<<" | ">>"
  22.  
  23.    | means alternatives, [] means an apperance of none or one time
  24.  
  25. */
  26.  
  27. ENUM DIV_BY_ZERO,UNMATCHED_PARENTHESES,SYNTAX_ERR,STACK_OV,
  28.      TERM_EXPECTED,KOMMA_EXPECTED,PUP_EXPECTED,UNEXPECTED_LE,PCLOSE_EXPECTED,
  29.      ARG_EXPECTED
  30.  
  31. RAISE STACK_OV IF FreeStack()<100
  32.  
  33. PROC main() HANDLE
  34. DEF string,always_true= TRUE,buffer[256]:STRING,fertig= FALSE
  35.   WriteF('Mycalc v1.0 by Nico Max, written in Amiga_E\nType \ahelp\a for help\n\n')
  36.   REPEAT
  37.     WriteF('>>'); ReadStr(stdout,buffer)
  38.     LowerStr(buffer); string:= TrimStr(buffer)
  39.     SELECT always_true
  40.       CASE StrCmp(string:= TrimStr(string),'help',STRLEN)
  41.         WriteF(' the following commands will be supported:\n\n'+
  42.                '    help   - prints this message\n'+
  43.                '    exit   - quits the program\n'+
  44.                '    <exp>  - calculates the expression\n\n'+
  45.                ' infix operators:   +,-,*,/  - basic operators\n'+
  46.                '                    ^,mod    - power, modulo\n'+
  47.                '                    <<,>>    - bitwise shift left, shift right\n'+
  48.                ' prefix operators:  ~        - logical Not\n'+
  49.                '                    $,%      - indicator for hex and bin nums\n'+
  50.                ' postfix operators: !        - faculthy\n'+
  51.                '         functions: Abs()    - absolute value\n\n')
  52.       CASE StrCmp(string,'exit',STRLEN); fertig:= TRUE
  53.       CASE StrCmp(string,''    ,ALL); NOP
  54.       DEFAULT; calcline(string)
  55.     ENDSELECT
  56.   UNTIL fertig
  57.   WriteF('bye bye...\n')
  58. EXCEPT
  59. ENDPROC
  60.  
  61. PROC calcline(buf) HANDLE
  62. DEF x=0:PTR TO LONG,l=0
  63.   l:= term(buf:= TrimStr(buf),{x}) /* returns length of examined linepart */
  64.   IF Char(TrimStr(buf+l)) THEN Raise(UNEXPECTED_LE)
  65.   WriteF('->\d\n\n',x)            /* print result */
  66. EXCEPT
  67.   x:= ['Division by Zero','Unmatched parentheses','Syntax error',
  68.        'Stack overflow', 'Term expected',
  69.        'Komma expected','"(" expected','Unexpected end of line',
  70.        '")" expected','Argument expected']
  71.   WriteF('\s!\n',x[exception])
  72. ENDPROC
  73.  
  74. PROC term (string,value)
  75. DEF x,y,o,t,length
  76.   FreeStack()                   /* check stacksize */
  77.   IF Char(t:= TrimStr(string))="(" /* "("? => term beginning */
  78.     length:= term(t:= TrimStr(t+1),{x})   /* go rekursive... */
  79.     IF Char(t:= TrimStr(t+length))=")"
  80.       IF length:= op(t:=TrimStr(t+1),{o})  /* check for infix operator */
  81.         length:= term(t:= TrimStr(t+length),{y})
  82.         ^value:= exp(x,y,o)         /* calculate result of both subterms x,y*/
  83.         RETURN t+length-string      /* return termlength */
  84.       ELSE; ^value:= x; RETURN t-string; ENDIF
  85.     ELSE; Raise(UNMATCHED_PARENTHESES); ENDIF
  86.   ELSE
  87.     IF (length:= num(t,{x}))=0 THEN length:= func(t,{x})
  88.     IF length
  89.       LOOP
  90.         IF length:= op(t:= TrimStr(t+length),{o})
  91.           IF (length:= num(t:= TrimStr(t+length),{y}))=0 THEN length:= term(t,{y})
  92.           ^value:= x:= exp(x,y,o)
  93.         ELSE; ^value:= x; RETURN t-string; ENDIF
  94.       ENDLOOP
  95.     ELSE; Raise(SYNTAX_ERR); ENDIF
  96.   ENDIF
  97. ENDPROC
  98.  
  99. PROC func(string,value)
  100. DEF x= TRUE,buffer,length=0,
  101.     params[1]:LIST /* holds parameters for the functions; choose the num
  102.                       as large as the functins with the most parameters
  103.                       need */
  104.   buffer:= string
  105.   SELECT x
  106.     CASE StrCmp(string,'abs',STRLEN)
  107.       length:= checkprocparameters(buffer:= TrimStr(string+STRLEN),params,1)
  108.       ^value:= Abs(params[])
  109.   ENDSELECT
  110. ENDPROC buffer+length-string
  111.  
  112. PROC checkprocparameters(string,params:PTR TO LONG,numparams)
  113. DEF length=0,buffer,x=0
  114.   DEC numparams
  115.   IF string[]="("
  116.     IF Char(buffer:= TrimStr(string+1))
  117.       length:= term(buffer,params)
  118.     ELSE; Raise(ARG_EXPECTED); ENDIF
  119.     WHILE x++ < numparams
  120.       IF Char(buffer:= TrimStr(buffer+length))=","
  121.         IF Char(buffer:= TrimStr(buffer+1))
  122.           length:= term(buffer:= TrimStr(buffer+1),params+Shl(x+1,2))
  123.         ELSE; Raise(ARG_EXPECTED); ENDIF
  124.       ELSE; Raise(KOMMA_EXPECTED); ENDIF
  125.     ENDWHILE
  126.     IF Char(buffer:= TrimStr(buffer+length))<>")" THEN Raise(PCLOSE_EXPECTED)
  127.   ELSE; Raise(PUP_EXPECTED); ENDIF
  128. ENDPROC buffer+1-string
  129.  
  130. PROC exp(x,y,o)  /* calculating result depending of the given operator */
  131. DEF i=1,t
  132.   SELECT o
  133.     CASE "+";   RETURN x+y
  134.     CASE "-";   RETURN x-y
  135.     CASE "/";   IF y THEN RETURN Div(x,y) ELSE Raise(DIV_BY_ZERO)
  136.     CASE "*";   RETURN Mul(x,y)
  137.     CASE "^";   FOR t:= 1 TO y DO i:= Mul(i,x); RETURN i
  138.     CASE "mod"; IF y THEN RETURN Mod(x,y) ELSE Raise(DIV_BY_ZERO)
  139.     CASE "<<";  RETURN Shl(x,y)
  140.     CASE ">>";  RETURN Shr(x,y)
  141.     CASE "~";   RETURN Not(x)
  142.     CASE "!";   FOR t:= 1 TO x DO i:= Mul(i,t); RETURN i
  143.   ENDSELECT
  144. ENDPROC
  145.  
  146. PROC num(string,value)   /* checking for numeric */
  147. DEF x,t,o,i=0
  148.   t:= prefix(string,{o}); ^value:= Val(string:= string+t,{x})
  149.   IF x
  150.     IF t THEN ^value:= exp(^value,0,o)
  151.     IF i:= postfix(string+x,{o}) THEN ^value:= exp(^value,0,o)
  152.   ENDIF
  153. ENDPROC x+i+t
  154.  
  155. PROC prefix(string,value)
  156. DEF x
  157.   ^value:= x:= string[];
  158.   SELECT x
  159.     CASE "~"; RETURN 1  /* return length of found operator, must be <= 4 */
  160.   ENDSELECT
  161. ENDPROC
  162.  
  163. PROC postfix(string,value)
  164. DEF x
  165.   ^value:= x:= string[]
  166.   SELECT x
  167.     CASE "!"; RETURN 1  /* return length of found operator, must be <= 4 */
  168.   ENDSELECT
  169. ENDPROC
  170.  
  171. PROC op(buffer,o)  /* checking infix operators */
  172. DEF t= TRUE,l=0
  173.   SELECT t
  174.     CASE StrCmp(buffer,'*'  ,STRLEN); ^o:= "*";   l:= STRLEN
  175.     CASE StrCmp(buffer,'/'  ,STRLEN); ^o:= "/";   l:= STRLEN
  176.     CASE StrCmp(buffer,'-'  ,STRLEN); ^o:= "-";   l:= STRLEN
  177.     CASE StrCmp(buffer,'+'  ,STRLEN); ^o:= "+";   l:= STRLEN
  178.     CASE StrCmp(buffer,'^'  ,STRLEN); ^o:= "^";   l:= STRLEN
  179.     CASE StrCmp(buffer,'mod',STRLEN); ^o:= "mod"; l:= STRLEN
  180.     CASE StrCmp(buffer,'<<', STRLEN); ^o:= "<<";  l:= STRLEN
  181.     CASE StrCmp(buffer,'>>', STRLEN); ^o:= ">>";  l:= STRLEN
  182.   ENDSELECT
  183. ENDPROC l
  184.